00100	C**PRESCN, CROCT, CROCX, UPMK, ONEUP, NUMS, LETS, ISGN, I2A, A2I
00200	C** UPLIST. LETNUM. UPCNT, OUTX, ICHAR, TYPARY
00300	
00400		SUBROUTINE PRESCN
00500		COMMON NONO(29),JB(6),JP(1),J2,J3,J4,J5,JN,J,JJ 
00600		1 /MKX/KSLA,ISEMI,LESS,IGT,LBRK,IRBRK,NNO(3),MINUS
00700		1/DPY/ST(2190),ICRS(5),IOCT(5),NTS(600),IRH(400),IM(200),
00800		1 IB(200),ISL(200)  /ALF/I(73) /MKS/MKS(14)
00900		1 /JCHAR/IXX,ISEMX,IBLA,IG  /IDEV/IDEV     /BKSLSH/IBKSL
01000		1 /SCX/ICOM,MINU,IDOT,IEQ,LPRN,IRPRN,IPLUS,ISTAR,ICOLON
01100		COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,
01200		1 LMM,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
01210		DATA IBKSL/"561004020100/
01255	C  ABOVE FOR BACKSLASH
01300	CC	EQUIVALENCE (IOO,MKS(14)),(IR,MKS(13)),(IP,MKS(11)),(IA,MKS(2))
01400		EQUIVALENCE (J1,JP(1))
01500		IF(IDEV.EQ.5)GO TO 401
01600		CALL TYPSTR('***** READING FILE *****')
01700		CALL TYPCRLF
01800	401	CALL OFILE(23,'MODE2')
01900	400	DO 402 K=1,6
02000		JB(K)=0
02100	402	JP(K)=0
02200		JN=0
02300		N=0
02400	
02500		DO 300 K=1,200
02600		IM(K)=0
02700	300	ISL(K)=0
02800	 
02900	100	IF(N.NE.ISEMI)GO TO 500
03000		CALL TYPSTR('NOTES: ')
03100		CALL OUTIT(NTS,J1)
03200		CALL TYPSTR('RHYTHM: ')
03300		CALL OUTIT(IRH,J2)
03400		CALL TYPSTR('MARKS: ')
03500		CALL OUTIT(IM,J3)
03600		CALL TYPSTR('BEAMS: ')
03700		CALL OUTX(IB,J4)
03800		CALL TYPSTR('SLURS: ')
03900		CALL OUTX(ISL,J5)
04000	C NOW START ANOTHER STAFF.
04100		GO TO 400
04200	
04300	500	CALL READ(LND)
04400		IF(LND)RETURN
04500	CCC	IF(I(1).EQ.'I')GO TO 50
04600	C 'I' IS FOR 'INSERT' FEATURE
04700		J=0
04800	201	JX=0
04900	200	J=J+1
05000		IF(J.GT.LND)GO TO 100
05100		N=I(J)
05200		IF(N.EQ.IBLA)GO TO 200
05300		JJ=J
05400	C JJ= PTR TO START OF ITEM
05500		GO TO(1,2,3,7,8,9,10)LETNUM(N)
05600	C FINDS LETTER, NUM., / OR ;, < OR >, [ OR ], ( , ) 
05700	 
05800	1	JC=I(J+1)
05900	 	IF(N.GT.LGG)GO TO 20
06000	C JUMP IF NOT SCALE LETTER
06100		IF(N.EQ.LBB.AND.JC.EQ.LAA)GO TO 21
06200	C JUMP IF BA (=BASS CLEF)
06300		IF(N.EQ.LAA.AND.JC.EQ.LEL)GO TO 21
06400	C JUMP IF AL (=ALTO CLEF)
06500	C*********↓↓↓↓↓↓↓↓↓↓↓↓*********************
06600		IF(N.NE.LCC)GO TO 22
06700		IF(JC.EQ.IPLUS.OR.JC.EQ.MINUS.OR.JC.EQ.LXX)GO TO 80
06800	C JUMP FOR CRESC. (C+), DECRESC. (C-), OR END OF ONE OF THEM (CX)
06900	C*********↑↑↑↑↑↑↑↑↑↑↑↑*********************
07000	22	JX=1
07100	122	N=ICHAR(J)
07200		IF(NUMS(N))GO TO 122
07300		IF(LETS(N))GO TO 122
07400		IF(N.EQ.ICOLON)GO TO 122
07500		IF(N.EQ.MINUS)GO TO 122
07600		IF(N.EQ.IPLUS)GO TO 122
07700	CC	IF(N.EQ.IBLA)GO TO 23
07800	CC	IF(N.EQ.KSLA)GO TO 23
07900	CC	IF(N.NE.ISEMI)GO TO 22
08000	23	J=J-1
08100	C NOW WE HAVE A NOTE
08200		CALL UPLIST(NTS,J1)
08300		GO TO 200
08400	
08500	20	IF(N.NE.LRR)GO TO 21
08600		JX=0
08700		IF(I(J+1).EQ.LEE)GO TO 301
08800	C JUMP FOR 'REP' CODE 
08900		GO TO 122
09000	21	IF(N.EQ.LPP)GO TO 22
09100		IF(N.NE.LOH)GO TO 121
09200	C P=PROX., O=ORDIN.  BOTH ARE FOLLOWED BY NOTES.  O+ = OTTAVA
09300		IF(JC.EQ.IPLUS)GO TO 85
09400		IF(JC.EQ.LXX)GO TO 86
09500		GO TO 22
09600	121	N=ICHAR(J)
09700		IF(N.NE.KSLA.AND.N.NE.ISEMI)GO TO 121
09800	C NOW WE'VE FOUND /TR/  /SU/  K2F/  ETC.
09900		CALL UPLIST(NTS,J1)
10000		GO TO 201
10100	 
10200	2 	N=ICHAR(J)
10300	12	IF(NUMS(N))GO TO 2
10400	25	J=J-1
10500	CCC	IF(I(J).EQ.'0')I(J)=LGG
10600	28	CALL UPLIST(IRH,J2)
10700		GO TO 200
10800	3	CALL ONEUP(NTS,J1,N)
10900		CALL ONEUP(IRH,J2,N)
11000	C PUT IN THE / OR ;
11100		IF(JX.NE.0)JN=JN+1 
11200		GO TO 200
11300	
11400	C SLURS
11500	9	ISL(J5+1)=ISGN(J)
11600		J5=J5+2
11700		M=-1
11800		GO TO 24
11900	
12000	10	N=J5
12100	C SLUR END POINT
12200	110	IF(ISL(N).EQ.0)GO TO 109
12300		N=N-2
12400	C ADD AN ERROR TRAP HERE
12500		GO TO 110
12600	109	ISL(N)=JN+1
12700		GO TO 200
12800	  
12900	C BEAMS
13000	8	IF(I(J+2).EQ.IRBRK)GO TO 4
13100		J4=J4+1
13200		IB(J4)=ISGN(J)
13300		M=0
13400	24	IF(NUMS(I(J+1)).EQ.0)GO TO 200
13500	C JUMP OUT IF NO NUMB. FOLLOWS [ OR (
13600		N=ICHAR(J)
13700		CALL A2I(J,N)
13800	C GO CHANGE ASCII TO INTEGER
13900		L=N+JN
14000		IF(M)GO TO 34
14100		CALL ONEUP(IB,J4,L)
14200		GO TO 200
14300	34	IF(N.LT.96)GO TO 35
14400	C NEXT FOR SLURS BEFORE AND AFTER LIMITS
14500	C 99=SLUR ABOVE NOTE→PAST END; 98=SLUR AT NOTE LEVEL→PAST END
14600	C 97=SLUR ABOVE NOTE←FROM BEFORE END; 96=SLUR AT NOTE LEVEL←FROM BEFORE END
14700		L=N
14800		IF(N.EQ.99)L=99
14900		IF(N.EQ.98)L=JN+2
15000	35	ISL(J5)=L
15100	C SLUR END POINT
15200		GO TO 200
15300	
15400	4	J=J+2
15500		IF(NUMS(I(J+1)))GO TO 42
15600		JC=ISEMI
15700		JD=0
15800		N=1
15900	14	J4=J4+3
16000		IB(J4-2)=I(J-N)
16100		IB(J4-1)=LBB
16200		IB(J4)=JC
16300		IF(JD.EQ.0)GO TO 200
16400		J4=J4+1
16500		IB(J4)=JD
16600		GO TO 200
16700	42	JC=ICHAR(J)
16800		JD=ISEMI
16900		N=2
17000		GO TO 14
17100	 
17200	7	N=1
17300	74	CALL UPMK(JN+N,0,IBLA)
17400	70	N=ICHAR(J)
17500		IF(N.EQ.IBLA)GO TO 70
17600		IF(NUMS(N).EQ.0)GO TO 73
17700		CALL A2I(J,N)
17800	C CHANGES ASCII TO INTEGER
17900		GO TO 74
18000	C NOW SHOULD BE LETTERS
18100	73	L=J+1
18200	C*********↓↓↓↓↓↓↓↓↓↓↓↓*********************
18300	77	N=I(L)
18400		IF(N.NE.IDOT)GO TO 71
18500		IM(J3)=N
18600		IM(J3+1)=I(L+1)
18700	C ONLY ONE DIGIT TO RIGHT OF DECIMAL IS ALLOWED.
18800		IM(J3+2)=IBLA
18900		J3=J3+2
19000		I(L)=IBLA
19100		L=L+1
19200		I(L)=IBLA
19300	71	IF(N.EQ.IBKSL.OR.N.EQ.IGT.OR.N.EQ.IBLA)GO TO 75
19400	78	L=L+1
19500		IF(L.LE.LND)GO TO 77
19600	75	DO 72 N=J,L-1
19700		J3=J3+1
19800	72	IM(J3)=I(N)
19900		J=L
20000		J3=J3+1
20100		IM(J3)=KSLA
20200		GO TO 76
20300	79	J=J+1
20400	76	N=I(J)
20450		IF(N.EQ.IBKSL.OR.N.EQ.IGT)GO TO 200
20475	C YOU CAN USE <  >  OR  \  \  FOR DELIMITERS.
20500		IF(N.EQ.IBLA)GO TO 79
20600	C*********↑↑↑↑↑↑↑↑↑↑↑↑*********************
20700		J=J-1
20800		GO TO 7
20900	 
21000	C*********↓↓↓↓↓↓↓↓↓↓↓↓*********************
21100	80	IF(JC.EQ.IXX)GO TO 81
21200	C SETSUP 1ST PART OF CRESC-DECRESC
21300		CALL CROCT(ICRS,N,JC)
21400	84	J=J+1
21500		GO TO 200
21600	85	CALL CROCT(IOCT,N,IBLA)
21700		GO TO 84
21800	81	CALL CROCX(ICRS)
21900		GO TO 84
22000	86	CALL CROCX(IOCT)
22100		GO TO 84
22200	C*********↑↑↑↑↑↑↑↑↑↑↑↑*********************
22300		
22400	301	J=J+2
22500	CODE FOR 'REP N M/'
22600		JC=-1
22700	30	N=ICHAR(J)
22800		IF(N.EQ.IBLA)GO TO 30
22900		CALL A2I(J,N)
23000		IF(JC.GE.0)GO TO 31
23100		JC=N
23200	C JC IS NOW 1ST NUM AFTER REP.
23300		GO TO 30
23400	31	JD=J1
23500	C N IS NOW 2ND NUMBER.
23600		IRP=0
23700		ITM=0
23800		JZ=JC
23900		IF(JZ.GT.100)JZ=JZ-100
24000	C >100 IS FOR 'REP' WITHOUT REPEATING ACCIS.
24100	33	MM=JD
24200	32	JD=JD-1
24300		IF(NTS(JD).NE.KSLA)GO TO 32
24400	C BACK UP TO PREV. SLASH
24500		IF(MM-JD.GT.1)GO TO 39
24600		IRP=IRP+1
24700		GO TO 33
24800	C NOW LOOK FORWARD TO 1ST CHAR. AFTER SLASH
24900	39	MM=NTS(JD+1)
25000		IF(MM.EQ.LRR)GO TO 36
25100		IF(MM.EQ.LOH)GO TO 37
25200		IF(MM.EQ.LPP)GO TO 37
25300		IF(MM.GT.LGG)GO TO 33
25400	37	ITM=ITM+1
25500	36	JZ=JZ-1
25600	38	IF(JZ.GT.0)GO TO 33
25700		JN=JN+ITM*(N-1)
25800		CALL UPLIST(NTS,J1)
25900		GO TO 28
26000	 
26100		END
26200		
26300		SUBROUTINE CROCT(K,N,JC)
26400		DIMENSION K(1)
26500		COMMON NONO(35),J1,J2,J3,J4,J5,JN,J,JJ /ALF/I(1)
26600		1 /SCX/ICOM,MINU,IDOT
26700	C SETSUP 1ST PART OF CRESC-DECRESC, OTTAVA
26800		K(1)=JN+1
26900	 	K(2)=JC
27000		K(3)=I(J+2)
27100		K(4)=I(J+3)
27200	C K4 SHOULD BE / ; BLANK OR NUM.
27300		IF(K(3).EQ.IDOT)J=J+2
27400		END
27500	
27600		SUBROUTINE CROCX(K)
27700		COMMON NONO(35),J1,J2,J3,J4,J5,JN,J,JJ /ALF/I(1)
27800		1/DPY/ST(2190),ICRS(5),IOCT(5),NTS(600),IRH(400),IM(200)
27900		1 /MKX/KSLA  /JCHAR/IXX,ISEMX,IBLA
28000		DIMENSION K(1)
28100	81	CALL UPMK(K,K(3),IBLA)
28200		IM(J3+1)=I(J)
28300		IM(J3+2)=K(2)
28400		J3=J3+3
28500	 	IM(J3)=IBLA
28600		CALL UPMK(JN+1,I(J+2),KSLA)
28700		END
28800	
28900		SUBROUTINE UPMK(N,L,LL)
29000		DIMENSION L(1)
29100		COMMON NO(35),J1,J2,J3,J4,J5,JN,J,JJ
29200		1/DPY/ST(2190),ICRS(5),IOCT(5),NTS(600),IRH(400),IM(200)
29300		1 /MKX/KSLA,ISEMI,LESS,IGT,LBRK,IRBRK /NUM/N0 
29400		1 /SCX/ICOM,MINU,IDOT
29500		J3=J3+3
29600		CALL I2A(N,MM,M,N)
29700		IM(J3-2)=M
29800		IF(M.EQ.N0)J3=J3-1
29900		IM(J3-1)=N
30000		IF(L(1).NE.IDOT)GO TO 1
30100		IM(J3)=IDOT
30200		J3=J3+2
30300		IM(J3-1)=L(2)
30400		IF(LL.EQ.KSLA)J=J+2
30500	1	IM(J3)=LL
30600		END
30700	
30800		SUBROUTINE ONEUP(L,J,N)
30900		DIMENSION L(1)
31000		J=J+1
31100		L(J)=N
31200		END
31300	
31400		FUNCTION NUMS(N)
31500		COMMON /NUM/N0,NN(8),N9 /SCX/ICOM,MINU,IDOT
31600	C FINDS ASCII NUMBER  (NUMS=-1)
31700		NUMS=0
31800		IF(N.GE.N0.AND.N.LE.N9)NUMS=-1
31900		IF(N.EQ.IDOT)NUMS=-1
32000	C DOT IS CONSIDERED PART OF A NUMBER
32100		END
32200	
32300		FUNCTION LETS(N)
32400		COMMON /A2Z/LAA,A(24),LZZ
32500	C FINDS LETTER  (LETS=-1)
32600		LETS=0
32700		IF(N.GE.LAA.AND.N.LE.LZZ)LETS=-1
32800		END
32900	
33000		FUNCTION ISGN(J)
33100		COMMON NO(35),J1,J2,J3,J4,J5,JN 
33200		1 /ALF/I(1) /MKX/NNO(9),MINUS
33300		1 /SCX/ICOM,MINU,IDOT,IEQ,LPRN,IRPRN,IPLUS,ISTAR
33400		ISGN=JN+1
33500		N=I(J+1)
33600		IF(N.EQ.IPLUS)GO TO 1
33700		IF(N.NE.MINUS)RETURN
33800		ISGN=-ISGN
33900		GO TO 2
34000	1	ISGN=ISGN+100
34100	C FOR SLUR AND BEAM STEM REVERSAL
34200	2	J=J+1
34300		END
34400	 
34500		SUBROUTINE I2A(JN,MM,M,N)
34600		COMMON/NUM/NUM(0/9)
34700		K=JN
34800		N=K/100
34900		MM=NUM(N)
35000		K=K-N*100
35100		N=K/10
35200		M=NUM(N)
35300		N=NUM(K-N*10)
35400	C CHANGES 2-DIGIT NUMBERS TO FROM INTEGER TO ASCII
35500		END
35600	 
35700		SUBROUTINE A2I(J,N)
35800		COMMON /ALF/I(1) /NUM/NUM(0/9)
35900		L=N
36000		N=0
36100	3	DO 1 K=0,9
36200	1	IF(L.EQ.NUM(K))GO TO 2
36300	2	N=N*10+K
36400		L=I(J+1)
36500		IF(NUMS(L).EQ.0)RETURN
36600		J=J+1
36700		GO TO 3
36800		END
36900	 
37000		SUBROUTINE UPLIST(N,K)
37100		DIMENSION N(1)
37200		COMMON NONO(35),J1,J2,J3,J4,J5,JN,J,JJ
37300		COMMON /ALF/I(1)
37400		DO 1 L=JJ,J
37500		K=K+1
37600	1	N(K)=I(L)
37700		END
37800	 
37900		FUNCTION LETNUM(N)
38000		COMMON NONO(35),J1,J2,J3,J4,J5,JN,J,JJ /MKX/MKX(1)
38100		COMMON /ALF/I(1) /NUM/NUM(0/9) /JCHAR/IXX,ISEMX,IBLA
38150		1 /BKSLSH/IBKSL
38200	1	IF(N.NE.IBLA)GO TO 2
38300		N=ICHAR(J)
38400		GO TO 1
38500	2	IF(NUMS(N).EQ.0)GO TO 3
38600	4	LETNUM=2
38700		RETURN
38800	3	IF(LETS(N).EQ.0)GO TO 40
38900	CATCHES LETTERS AND MINUS SIGN (FOR INVIS. CLEFS)
39000	7	LETNUM=1
39100		RETURN
39200	40	DO 5 K=1,11
39300	5	IF(N.EQ.MKX(K))GO TO (6,6,9,9,10,10,11,11,4,7,8)K
39350		IF(N.EQ.IBKSL)GO TO 9
39375	C  BIG NUMBER='\'  (BACKSLASH - CAN REPLACE < >)
39400	CCC	CALL ERR(J)
39500	6	LETNUM=3
39600	C /  ;
39700		RETURN
39800	8	LETNUM=8
39900	C *   
40000		RETURN
40100	9	LETNUM=4
40200	C < >
40300		RETURN
40400	10	LETNUM=5
40500	C [ ]]
40600		RETURN
40700	11	LETNUM=K-1
40800	C ( )
40900		END
41000	 
41100		SUBROUTINE UPCNT
41200		COMMON NONO(35),J1,J2,J3,J4,J5,JN,J,JJ
41300		COMMON /ALF/I(1) /NUM/NUM(0/9) /JCHAR/IXX,ISEMX,IBLA
41400	C GETS LAST NOTE NUM.
41500		K=J
41600		JR=0
41700	1	K=K-1
41800		N=I(K)
41900		IF(NUMS(N))GO TO 1
42000		CALL A2I(K,N)
42100		IF(JR.NE.0)GO TO 4
42200		JN=JN+N-1
42300		RETURN
42400	2	JR=N
42500	3	K=K-1
42600		IF(I(K).EQ.IBLA)GO TO 3
42700		GO TO 1
42800	4	JN=JN+JR*N-N-1
42900		END
43000	 
43100		SUBROUTINE OUTX(IX,J)
43200		DIMENSION IX(1)
43300		COMMON NONO(35),J1,J2,J3,J4,J5,K,L,MM/NUM/N0,NO(8),N9
43400		1/DPY/ST(2200),NTS(600),IRH(400),IM(200),IB(200),ISL(200) 
43500		1 /MKX/KSLA,ISEMI /JCHAR/IXX,ISEMX,IBLA /A2Z/LAA,LBB
43600		1 /SCX/ICOM,MINUS
43700		K=1
43800		IF(J.LE.1)GO TO 4
43900		IF(IX(2).NE.LBB)GO TO 3
44000	C NEXT FOR AUTO-BEAMS  (E.G. 2B;  3B1; ETC.)
44100		CALL OUTIT(IX,J)
44200		RETURN
44300	
44400	3	DO 6 L=1,J,2
44500		MM=IX(L)
44600		IF(MM.GE.100)GO TO 5
44700		IF(MM.GE.0)GO TO 6
44800		IX(L)=-MM
44900	CHANGE -M,N TO M,-N
45000		IX(L+1)=IX(L+1)+200
45100		GO TO 6
45200	5	IX(L)=MM-100
45300	CHANGES M+100,N TO M,N+100
45400		IX(L+1)=IX(L+1)+100
45500	6	CONTINUE
45600	
45700		JJ=IBLA
45800		NN=1
45900		DO 1 L=1,J
46000		LL=IX(L)
46100		CALL I2A(LL,MM,M,N)
46200		IF(LL.LT.96)GO TO 7
46300		IF(LL.GE.99)GO TO 7
46400		IF(LL.EQ.98)GO TO 8
46500		MY=NTS(K-3)
46600		MZ=NTS(K-2)
46700		NTS(K-4)=MINUS
46800		IF(LL.EQ.96)GO TO 10
46900		N=N9 
47000		GO TO 11
47100	10	M=N0 
47200		N=MZ
47300	11	NTS(K-3)=M
47400		IF(M.EQ.N0)K=K-1
47500		NTS(K-2)=N
47600		M=MY
47700		N=MZ
47800		GO TO 7
47900	C THESE ARE FOR SLURS BEFORE AND AFTER STAFF LIMIT
48000	8	N=N0 
48100		M=N0 
48200	7	NTS(K)=MM
48300		IF(MM.EQ.N0)K=K-1
48400		NTS(K+1)=M
48500		IF(M.EQ.N0.AND.MM.EQ.N0)K=K-1
48600		NTS(K+2)=N
48700		NTS(K+3)=JJ
48800		JJ=KSLA
48900		IF(NN)JJ=IBLA
49000		NN=-NN
49100	1	K=K+4
49200		K=K-1
49300	4	NTS(K)=ISEMI
49400		DO 2 L=K+1,K+79
49500	2	NTS(L)=IBLA
49600		CALL OUTIT(NTS,K)
49700		END
49800	 
49900		FUNCTION ICHAR(J)
50000		COMMON /ALF/I(1)
50100		J=J+1
50200		ICHAR=I(J)
50300		END
50400	
50500		SUBROUTINE TYPARY(I,K)
50600		DIMENSION I(1)
50700		DO 8 L=1,K
50800	8	CALL TYPCHR(I(L),1)
50900		CALL TYPCRLF
51000		END
51100	
51200		SUBROUTINE READ(K)
51300		COMMON NONO(29),JB(6),JP(6) /IDEV/IDEV /JCHAR/IXX,ISEMX,IBLA
51400		COMMON /ALF/I(73) /MKX/KSLA,ISEMI/NUM/NUM(10),JRD
51500		1 /A2Z/AA,BB,LCC,NO(11),LOH
51600	C ALL DATA IN WORDS DATA NUM/'0','1','2','3','4','5','6','7','8','9'/,JRD/0/
51700		EQUIVALENCE (N9,NUM(10))
51800	14	IF(JRD)GO TO 2
51900		IF(IDEV.NE.5)GO TO 1
52000	15	CALL TYPSTR('TYPE @@ ')
52100		CALL TYPCRLF
52200	C IDEV=0 AFTER ';' IS SEEN.
52300	1	READ(IDEV,10,END=2)I
52400		IF(I(1).NE.LCC)GO TO 4
52500		IF(I(2).NE.LOH)GO TO 4
52600	C FOR X!Z&#% ET DIRECTORY
52700	5	READ(1,10)I
52800		IF(I(3).NE.ISEMI)GO TO 5
52900		GO TO 1
53000	4	IF(I(1).NE.N9)GO TO 11
53100		IF(I(2).NE.N9)GO TO 11
53200	C TYPE '99' TO BACKUP  - ONE LINE ONLY EACH TIME.
53300		DO 12 L=1,6
53400	C GET BACK LAST POINTERS
53500	12	JP(L)=JB(L)
53600		IF(IDEV.EQ.5)CALL TYPCHR('RE',2)
53700		GO TO 15
53800	11	DO 16 K=73,1,-1
53900		N=I(K)
54000	16	IF(N.EQ.KSLA.OR.N.EQ.ISEMI)GO TO 17
54100		GO TO 15
54200	17	DO 9 L=1,K
54300	C WIPE OUT COMMAS
54400	9	IF(I(L).EQ.',')I(L)=IBLA
54500		DO 13 L=1,5
54600	C SAVE POINTERS FOR POSSIBLE BACKUP
54700	13	JB(L)=JP(L)
54800	
54900	CC	DO 3 K=73,1,-1
55000	CC	N=I(K)
55100		IF(N.EQ.ISEMI)JRD=-1
55200	CC	IF(N.NE.KSLA.AND.N.NE.ISEMI)GO TO 3
55300		IF(IDEV.EQ.5)WRITE(21,10)(I(L),L=1,K)
55400	C SAVE TYPED INPUT ON 'FOR21.DAT'
55500		RETURN
55600	CC3	CONTINUE
55700	CC	GO TO 1
55800	C UNTERMINATED LINE (NO / OR ; )IS IGNORED. (FOR COMMENTS)
55900	CC	IF(I(1).NE.'@')GO TO 1
56000	C START LINE WITH '@' FOR LITERAL REPRODUCTION.
56100	CCC	DO 6 K=73,1,-1
56200	CCC6	IF(I(K).NE.' ')GO TO 7
56300	CCC7	WRITE(23,10)(I(L),L=2,K)
56400	CC	TYPE 10,(I(L),L=1,K)
56500	CCC	CALL TYPARY(I,K)
56600	CCC	GO TO 1
56700	C IGNORES BLANK LINES OR UNTERMINATED LINES.
56800	10	FORMAT(73A1)
56900	2	END FILE 23
57000		IF(IDEV.EQ.5)END FILE 21
57100		JRD=0
57200		K=-1
57300		END
57400		
57500		SUBROUTINE OUTIT(I,K)
57600		COMMON /MKX/KSLA,ISEMI /IDEV/IDEV
57700		DIMENSION I(1)
57800		IF(K.EQ.0)K=1
57900		I(K)=';'
58000		M=1
58100	1	N=M+60
58200		DO 2 L=N,M,-1
58300		J=I(L)
58400	2	IF(J.EQ.KSLA.OR.J.EQ.ISEMI)GO TO 3
58500	3	IF(L.GT.K)L=K
58600		WRITE(23,10)(I(J),J=M,L)
58700	CC	TYPE 11,(I(J),J=M,L)
58800		CALL TYPARY(I(M),L-M+1)
58900		IF(L.EQ.K)RETURN
59000		M=L+1
59100		GO TO 1
59200	10	FORMAT(70A1)
59300	CC11	FORMAT(1X70A1)
59400		END
59500